home *** CD-ROM | disk | FTP | other *** search
/ Aminet 8 / Aminet 8 (1995)(GTI - Schatztruhe)[!][Oct 1995].iso / Aminet / util / rexx / VerCtrl_1_16.lha / VerCtrl.rexx < prev   
OS/2 REXX Batch file  |  1995-08-05  |  6KB  |  201 lines
  1. /*\
  2.  *
  3.  *  $VER: VerCtrl.rexx 1.16 (5.8.95)
  4.  *
  5. \*/
  6.  
  7. VersMsg = "VerCtrl.rexx 1.16 (5.8.95)"
  8. Author  = "Dave Freeman"
  9. Contact = "dfreeman@icecave.apana.org.au"
  10.  
  11. OPTIONS RESULTS
  12.  
  13. SIGNAL ON ERROR
  14. SIGNAL ON BREAK_C
  15. SIGNAL ON SYNTAX
  16.  
  17. LibList = 'rexxsupport.library rexxdossupport.library'
  18. DO Count = 1 TO WORDS(LibList)
  19.   IF ~SHOW('l',WORD(LibList,Count)) THEN DO
  20.     IF ~ADDLIB(WORD(LibList,Count),0,-30) THEN DO
  21.       CALL GSay("Error: "WORD(LibList,Count)"not available","Damn!")
  22.       EXIT 5
  23.       END
  24.     END
  25.   END
  26.  
  27. /* ----------------------------------------------------------------------------------------------- */
  28. /* Handle Args for the Program                                                                     */
  29. /* ----------------------------------------------------------------------------------------------- */
  30.  
  31. PARSE ARG ArgString
  32. Template = "RexxScript/A,DirPath/A,New/S"
  33. IF ~ReadArgs(ArgString,Template) THEN DO
  34.   ErrorMsg = "Error: Incorrect/Incomplete Call to Script*NTemplate: "Template
  35.   CALL GSay(ErrorMsg,"OK")
  36.   END
  37.  
  38. IF LEFT(DirPath,8) = 'Ram Disk' THEN DO
  39.   PARSE UPPER VAR DirPath ':' SubDirs
  40.   DirPath = 'RAM:'SubDirs
  41.   END
  42. IF INDEX(DirPath,':') = 0 THEN DirPath = DirPath':'
  43. ELSE IF (RIGHT(DirPath,1) ~= '/') & (RIGHT(DirPath,1) ~= ':') THEN DirPath = DirPath'/'
  44.  
  45. Work_Dir   = DirPath
  46. VStr       = 0
  47.  
  48. /* ----------------------------------------------------------------------------------------------- */
  49. StoreDir     = PRAGMA('D')                    /* Remember Current Dir and go back there at the end */
  50. CALL PRAGMA('D',Work_Dir)
  51. /* ----------------------------------------------------------------------------------------------- */
  52.  
  53. extpos = LASTPOS('.',RexxScript)
  54. IF extpos = 0 THEN DO
  55.   IF New = 1 THEN DO 
  56.     RexxPath = Work_Dir||RexxScript
  57.     END
  58.   ELSE DO 
  59.     RexxPath = Work_Dir
  60.     END
  61.   RexxScript = RexxScript'.rexx'
  62.   END
  63. ELSE DO
  64.   IF New = 1 THEN DO 
  65.     RexxPath = Work_Dir||LEFT(RexxScript,extpos - 1)
  66.     END
  67.   ELSE DO
  68.     RexxPath = Work_Dir
  69.     END
  70.   END
  71.  
  72. IF New = 1 THEN DO
  73.   CALL MAKEDIR(RexxPath)
  74.   RexxPath = RexxPath'/'
  75.   extpos    = LASTPOS('.',RexxScript)
  76.   scriptext = RIGHT(RexxScript,LENGTH(RexxScript) - extpos + 1)
  77.   IF EXISTS('REXX:RexxProg'scriptext) THEN DO
  78.     DefScript = 'REXX:RexxProg'scriptext
  79.     END
  80.   ELSE DO
  81.     DefScript = 'REXX:RexxProg.rexx'
  82.     END
  83.   CALL OPEN(WorkIn,DefScript,READ)
  84.   CALL OPEN(WorkOut,RexxPath||RexxScript,WRITE)
  85.   DO FOREVER
  86.     LineIn = READLN(WorkIn)
  87.     IF EOF(WorkIn) THEN LEAVE
  88.     IF INDEX(LineIn,' *  $VER:') = 1 THEN DO
  89.       LineIn = VerProc(LineIn)
  90.       END
  91.     IF INDEX(LineIn,'VersMsg = ') = 1 THEN DO
  92.       LineIn = 'VersMsg = 'VStr
  93.       END
  94.     CALL WRITELN(WorkOut,LineIn)
  95.     END
  96.   CALL CLOSE(WorkIn)
  97.   CALL CLOSE(WorkOut)
  98.   CALL SetVar(RexxDev.File,RexxPath||RexxScript,"Global")
  99.   END
  100. ELSE DO
  101.   CALL OPEN(WorkIn,RexxPath||RexxScript,READ)
  102.   CALL OPEN(WorkOut,RexxPath||RexxScript'.temp',WRITE)
  103.   DO FOREVER
  104.     LineIn = READLN(WorkIn)
  105.     IF EOF(WorkIn) THEN LEAVE
  106.     IF INDEX(LineIn,' *  $VER:') = 1 THEN DO
  107.       LineIn = VerProc(LineIn)
  108.       END
  109.     IF INDEX(LineIn,'VersMsg = ') = 1 THEN DO
  110.       LineIn = 'VersMsg = 'VStr
  111.       END
  112.     CALL WRITELN(WorkOut,LineIn)
  113.     END
  114.   CALL CLOSE(WorkIn)
  115.   CALL CLOSE(WorkOut)
  116.   CALL PRAGMA('D',RexxPath)
  117.   CALL DELETE(RexxScript)
  118.   CALL RENAME(RexxScript'.temp',RexxScript)
  119.   END
  120.  
  121. /* ----------------------------------------------------------------------------------------------- */
  122. CALL PRAGMA('D',StoreDir)                             /* Change to LogPath Dir for Stat Processing */
  123. /* ----------------------------------------------------------------------------------------------- */
  124.  
  125. EXIT(0)
  126.  
  127. /* ----------------------------------------------------------------------------------------------- */
  128. /* CALL Routines start here                                                                        */
  129. /* ----------------------------------------------------------------------------------------------- */
  130.  
  131. VerProc: PROCEDURE EXPOSE RexxScript VStr
  132. WorkLine = ARG(1)
  133. IF WORDS(WorkLine) > 2 THEN DO
  134.   PARSE VAR WorkLine junk junk progname verstr datestr
  135.   verstr   = VerInc(verstr)
  136.   datestr  = DateInc()
  137.   WorkLine = " *  $VER: "progname" "verstr" "datestr
  138.   IF VStr = 0 THEN VStr = '"'progname' 'verstr' 'datestr'"'
  139.   END
  140. ELSE DO
  141.   PARSE VAR WorkLine comnt verstr
  142.   verstr = 1.0
  143.   datestr = DateInc()
  144.   WorkLine = " *  $VER: "RexxScript" "verstr" "datestr
  145.   IF VStr = 0 THEN VStr = '"'RexxScript' 'verstr' 'datestr'"'
  146.   END
  147. RETURN(WorkLine)
  148.  
  149. VerInc: PROCEDURE
  150. VerStr = TRANSLATE(ARG(1),' ','.')
  151. VerStr = WORD(VerStr,1)'.'WORD(VerStr,2) + 1
  152. RETURN(VerStr)
  153.  
  154. DateInc: PROCEDURE
  155. DateStr = TRANSLATE(DATE('e'),' ','/')
  156. DateDay = STRIP(STRIP(WORD(DateStr,1)),'L','0')
  157. DateMnt = STRIP(STRIP(WORD(DateStr,2)),'L','0')
  158. DateYer = STRIP(WORD(DateStr,3))
  159. DateStr = '('DateDay'.'DateMnt'.'DateYer')'
  160. RETURN(DateStr)
  161.  
  162. GSay: PROCEDURE EXPOSE VersMsg               /* GSay("Message Text","Option1","Option2","OptionN") */
  163. GChoice. = 0 ; GChoiceStr = ' "'
  164. ArgCount = ARG()
  165. GTitle   = VersMsg
  166. GMessage = ARG(1)
  167. DO Count = 2 TO ArgCount
  168.   GChoiceStr    = GChoiceStr||ARG(Count)'" "'
  169.   END
  170. GChoiceStr = DELSTR(GChoiceStr,LENGTH(GChoiceStr) - 1)
  171. ADDRESS COMMAND 'RequestChoice "'GTitle'" "'GMessage'"'||GChoiceStr' >T:ChoiceRet'
  172. CALL OPEN(ChoiceIn,'T:ChoiceRet',READ)
  173. ChoiceRet = READLN(ChoiceIn)
  174. IF ChoiceRet = 0 THEN ChoiceRet = ArgCount - 1
  175. CALL CLOSE(ChoiceIn)
  176. CALL DELETE('T:ChoiceRet')
  177. RETURN(ChoiceRet)
  178.  
  179. /* ----------------------------------------------------------------------------------------------- */
  180. /* Error Handling Routines start here                                                              */
  181. /* ----------------------------------------------------------------------------------------------- */
  182.  
  183. BREAK_C:
  184.   Err1 = 'Break-C Signal Detected'
  185.   Err2 = 'Execution Ceased at line - 'SIGL
  186.   Err3 = 'Source Line: 'SourceLine(SIGL)
  187.   ErrText = Err1'*n'Err2'*n'Err3
  188.   CALL GSay(ErrText,"OK")
  189.   EXIT 10
  190. RETURN
  191.  
  192. ERROR:
  193. SYNTAX:
  194.   Err1 = 'Trapped Error: 'ErrorText(rc)
  195.   Err2 = 'Line 'SIGL':'SourceLine(SIGL)
  196.   ErrText = Err1'*n'Err2
  197.   CALL GSay(ErrText,"Damn!")
  198.   EXIT 20
  199. RETURN
  200.  
  201.